home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1985 July / Ahoy_Magazine_85-07_1985_Double_L.d64 / fast song maker (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  12KB  |  338 lines
  1. 0 print"[147]":poke53280,9:poke53281,7:poke646,9
  2. 1 print "               song maker":print:print
  3. 3 print"   this program lets you copy the fr$() strings from the screen display";
  4. 5 print" or save the fr$() strings on disk for retrieval by song loader"
  5. 7 print"   you type in songs at 9500-9890 and   name the song save file at 200"
  6. 10 gosub 9000:goto 80
  7. 60 for n=1 to len(md$(ph)):sys mm
  8. 62 f$=fr$(n,ph)
  9. 65 sys m
  10. 66 if ds=1 then gosub 500
  11. 67 for i=0 to du%(val(mid$(md$(ph),n,1))):next
  12. 68 rem sys mm:rem staccato notes
  13. 69 next:ph=ph+1:if ph>es% then ph=0
  14. 70 sys mm:return
  15. 80 print "[147]shift = 'play next phrase'"
  16. 81 print "    q = 'quit'"
  17. 82 print "    s = 'save song on disk'"
  18. 83 print "    d = 'make data statements at line            9400'"
  19. 84 print "    p = 'print each f$ string as it"
  20. 85 print "         plays; wait for keypress"
  21. 86 print "         between notes'"
  22. 87 print "    n = 'no printing of f$ strings'"
  23. 90 ds=0
  24. 100 print "                phrase "ph
  25. 110 if peek (653)<>0 then gosub 60:goto 100
  26. 120 a=peek(203):if a=64 then 110
  27. 130 if a=62 then poke 198,0:sys 65126:rem "warm start" ends program
  28. 135 if a=41 then ds=1:goto 110:rem set flag to print fr$() values
  29. 140 if a=13 then print "saving disk file":gosub 200
  30. 145 if a=39 then ds=0:rem set flag to stop printing fr$()
  31. 150 if a=18 then 20000:rem make data statements and wipe out lines>9400
  32. 190 goto 110
  33. 200 open 2,8,2,"@0:song #1,s,w"
  34. 210 cr$=chr$(13):print#2,es%cr$ev%cr$ld%cr$;
  35. 215 for i=0 to 2:print#2,g%(i)cr$;:next:for i=0 to 2
  36. 220 print#2,ak%(i)cr$dy%(i)cr$sn%(i)cr$re%(i)cr$;
  37. 225 for n=0 to 1:print#2,pw%(i,n)cr$;:next:next
  38. 230 for i=0 to 9:print#2,du%(i)cr$;:next
  39. 235 for ph=0 to es%:print#2,md$(ph)cr$;:print "<";
  40. 240 for n=1 to len(md$(ph)):for i=1 to 6
  41. 245 print#2,mid$(fr$(n,ph),i,1)cr$;:next:next:next
  42. 290 close 2:ph=0:return
  43. 500 print "note     [157][157][157]"n:for i=0 to 2:print "                    ":next
  44. 505 print "":for i=1 to 5 step 2
  45. 507 print "               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  46. 510 print asc(mid$(f$,i,1))"  "asc(mid$(f$,i+1,1))"  ":next
  47. 515 print "press shift to go on"
  48. 520 if peek(653)=0 then 520
  49. 525 print "[145]                     "
  50. 530 return
  51. 8998 rem set up sound shape
  52. 9000 f$="f":i=0:n=0:vc=0:m=848:mm=823:rem m&mm put ml in cassette buffer
  53. 9001 ph=0:es%=8:dim md$(es%),g%(2),ad(2),y%(2)
  54. 9002 dim me$(es%,2),mv$(es%,2)
  55. 9003 rem previous line:9002 dim me$(es%,2),mv$(es%,2)
  56. 9004 dim du%(9),pi%(168,1),ak%(2),dy%(2),sn%(2),re%(2),wf%(2),pw%(2,1)
  57. 9008 rem attack--voices 0,1,2
  58. 9009 rem number from 0 to 15; lower number=sharper attack
  59. 9010 ak%(0)=0:ak%(1)=0:ak%(2)=0
  60. 9015 for i=0 to 2:ak%(i)=ak%(i)*16:next
  61. 9018 rem decay--voices 0,1,2
  62. 9019 rem number from 0 to 15; lower number=faster decline
  63. 9020 dy%(0)=5:dy%(1)=3:dy%(2)=3
  64. 9028 rem sustain--voices 0,1,2
  65. 9029 rem number from 0 to 15; lower number=softer volume during sustain
  66. 9030 sn%(0)=2:sn%(1)=0:sn%(2)=0
  67. 9035 for i=0 to 2:sn%(i)=sn%(i)*16:next
  68. 9038 rem release--voices 0,1,2
  69. 9039 rem number from 0 to 15; lower number=faster drop to silence at end
  70. 9040 re%(0)=0:re%(1)=3:re%(2)=5
  71. 9048 rem set sound addresses
  72. 9050 for i=0 to 2:ad(i)=54277+7*i:next
  73. 9058 rem poke adsr envelopes
  74. 9060 for i=0 to 2:poke ad(i),ak%(i) or dy%(i)
  75. 9065 poke ad(i)+1,sn%(i) or re%(i):next
  76. 9067 rem set up gates
  77. 9068 rem waveforms, voices 0,1,2 (add values):
  78. 9069 rem triangle on=16; sawtooth on=32; pulse on=64 (set width!); noise on=128
  79. 9070 wf%(0)=32:wf%(1)=64:wf%(2)=64
  80. 9075 g%(0)=wf%(0)or 1:g%(1)=wf%(1) or 3:g%(2)=wf%(2) or 1
  81. 9078 rem set pulse widths
  82. 9079 rem voices 0,1,2; low byte, high byte
  83. 9080 pw%(0,0)=200:pw%(0,1)=3
  84. 9081 pw%(1,0)=200:pw%(1,1)=10
  85. 9082 pw%(2,0)=200:pw%(2,1)=7
  86. 9085 for i=0 to 2:vc=54274+i*7:for n=0 to 1
  87. 9086 poke vc+n,pw%(i,n):next:next
  88. 9098 rem set up durations
  89. 9100 for i=0 to 9:read du%(i):next
  90. 9105 data 40,96,128,192,256,384,512,640,768,1024
  91. 9196 rem machine language routine (at m)
  92. 9198 rem find address of f$ and put it in zero page at 139, 140
  93. 9200 n=peek(45)+256*peek(46)+3:y%=n/256:x%=n-y%*256
  94. 9205 poke m,173:poke m+1,x%:poke m+2,y%:n=n+1:y%=n/256:x%=n-y%*256
  95. 9210 poke m+3,133:poke m+4,251:poke m+5,173:poke m+6,x%:poke m+7,y%
  96. 9215 poke m+8,133:poke m+9,252:poke m+10,160:poke m+11,0
  97. 9220 poke m+12,162:poke m+13,0
  98. 9223 rem get each pitch from f$ and put it in frequency register
  99. 9225 for i=m+14 to m+54 step 8:poke i,177:poke i+1,251
  100. 9230 poke i+2,157:poke i+3,0:poke i+4,212
  101. 9235 poke i+5,200:poke i+6,162:read a:poke i+7,a:next
  102. 9236 data 1,7,8,14,15,4
  103. 9238 rem gate each sound open
  104. 9240 n=0:for i=m+59 to m+71 step 6
  105. 9241 poke i,173:a=mm-3+n:y%=a/256:x%=a-256*y%:poke i+1,x%:poke i+2,y%
  106. 9242 poke i+3,141:read a:poke i+4,a:poke i+5,212:n=n+1:next
  107. 9243 data 4,11,18
  108. 9248 rem garbage collection
  109. 9250 for i=m+77 to m+90:read a:poke i,a:next
  110. 9255 data 164,52,165,51,105,6,144,1,200,133,51,132,52,96
  111. 9258 rem gate-off ml routine at mm
  112. 9260 for i=mm to mm+16 step 8
  113. 9261 poke i,173:y%=3:x%=34+(i-mm)/8:poke i+1,x%:poke i+2,y%:rem uses 820-822
  114. 9262 poke i+3,41:poke i+4,254
  115. 9263 poke i+5,141:read a:poke i+6,a:poke i+7,212:next:poke mm+24,96
  116. 9264 data 4,11,18
  117. 9268 rem set waveforms with gates off
  118. 9269 rem stored at 820-822--line  9261 requires this (820=hex 03 34)
  119. 9270 poke 820,g%(0):poke 821,g%(1):poke 822,g%(2):sys mm
  120. 9297 rem set filter and volume
  121. 9298 rem filter frequency
  122. 9299 rem low byte (0-7) x%; high byte (0-255) y%
  123. 9300 x%=3:y%=150
  124. 9305 poke 54293,x%:poke 54294,y%
  125. 9308 rem filter on?
  126. 9309 rem voice 1 on=1; 2 on=2; 3 on=4; 1&2 on=3; 2&3 on=6; all on=7
  127. 9310 x%=0
  128. 9318 rem filter resonance
  129. 9319 rem peak volume (0=low, 15=high)
  130. 9320 y%=14
  131. 9325 y%=y%*16:poke 54295,x% or y%
  132. 9328 rem select filter type
  133. 9329 rem low-pass=1;band-pass=2;high-pass=4;lo-band=3;hi-band=6;all=7
  134. 9330 x%=1
  135. 9335 x%=x%*16
  136. 9338 rem select overall volume
  137. 9339 rem 15=high, 0=low
  138. 9340 y%=15:poke 54296,x% or y%
  139. 9345 ev%=2:rem set number of voices (minus 1)
  140. 9350 goto 9400
  141. 9358 rem music data loader (effective only if 'make data' was executed
  142. 9359 rem during main loop)
  143. 9360 read es%:read ld%:dim fr$(ld%,es%)
  144. 9365 for ph=0 to es%:read md$(ph):for n=1 to len(md$(ph)):print "!";
  145. 9370 for i=1 to 6:read a:fr$(n,ph)=fr$(n,ph)+chr$(a):next:next:next
  146. 9375 ph=0:return
  147. 9397 rem set up pitch array
  148. 9398 rem each note, in all its octaves
  149. 9399 rem c
  150. 9400 x%=3:gosub 9490
  151. 9401 data 12,1,24,2,48,4,97,8,195,16,135,33,15,67,30,134
  152. 9402 rem d
  153. 9403 x%=4:gosub 9490
  154. 9404 data 45,1,90,2,180,4,104,9,209,18,162,37,69,75,139,150
  155. 9405 rem e (f-flat)
  156. 9406 x%=5:gosub 9490:y%=13:gosub 9495
  157. 9407 data 81,1,163,2,71,5,143,10,31,21,62,42,125,84,250,168
  158. 9408 rem f (e-sharp)
  159. 9409 x%=6:gosub 9490:y%=19:gosub 9495
  160. 9410 data 102,1,204,2,152,5,48,11,96,22,193,44,131,89,6,179
  161. 9411 rem g
  162. 9412 x%=7:gosub 9490
  163. 9413 data 145,1,35,3,71,6,143,12,30,25,60,50,121,100,243,200
  164. 9414 rem a
  165. 9415 x%=1:gosub 9490
  166. 9416 data 195,1,134,3,12,7,24,14,49,28,99,56,199,112,143,225
  167. 9417 rem b
  168. 9418 x%=2:gosub 9490
  169. 9419 data 250,1,244,3,233,7,210,15,165,31,75,63,151,126,46,253
  170. 9420 rem d-flat (c-sharp)
  171. 9421 x%=11:gosub 9490:y%=17:gosub 9495
  172. 9422 data 28,1,56,2,112,4,225,8,195,17,134,35,12,71,24,142
  173. 9423 rem e-flat (d-sharp)
  174. 9424 x%=12:gosub 9490:y%=18:gosub 9495
  175. 9425 data 62,1,125,2,251,4,247,9,239,19,223,39,191,79,126,159
  176. 9426 rem g-flat (f-sharp)
  177. 9427 x%=14:gosub 9490:y%=20:gosub 9495
  178. 9428 data 123,1,246,2,237,5,218,11,181,23,107,47,214,94,172,189
  179. 9429 rem a-flat (g-sharp)
  180. 9430 x%=8:gosub 9490:y%=21:gosub 9495
  181. 9431 data 169,1,83,3,167,6,78,13,156,26,57,53,115,106,230,212
  182. 9432 rem b-flat (a-sharp)
  183. 9433 x%=9:gosub 9490:y%=15:gosub 9495
  184. 9434 data 221,1,187,3,119,7,239,14,223,29,190,59,124,119,248,238
  185. 9435 rem c-flat
  186. 9436 x%=10:gosub 9490
  187. 9437 data 4,1,250,1,244,3,233,7,210,15,165,31,75,63,151,126
  188. 9438 rem b-sharp
  189. 9439 x%=16:gosub 9490
  190. 9440 data 24,2,48,4,97,8,195,16,135,33,15,67,30,134,255,255
  191. 9485 goto 9500
  192. 9489 rem read pitches
  193. 9490 for i=0 to 147 step 21:read pi%(i+x%,0),pi%(i+x%,1):next:return
  194. 9494 rem identical pitches
  195. 9495 for i=0 to 147 step 21:pi%(i+y%,0)=pi%(i+x%,0):pi%(i+y%,1)=pi%(i+x%,1)
  196. 9496 next:return
  197. 9497 rem each phrase has only one du%(ph) string, no matter how many voices
  198. 9498 rem each phrase has one me$(ph,vc) & one mv$(ph,vc) string per voice
  199. 9499 rem phrase 0
  200. 9500 md$(0) = "100111111100111111"
  201. 9501 me$(0,0)="ffffgafg@ffffgafge"
  202. 9502 mv$(0,0)="6                 "
  203. 9503 me$(0,1)="cc@dcgdcccc@dcgdcc"
  204. 9504 mv$(0,1)="45 45354545 453545"
  205. 9505 me$(0,2)="fa@eagbc[191]fa@dagbc[191]"
  206. 9506 mv$(0,2)="34 34343434 343434"
  207. 9509 rem phrase 1
  208. 9510 md$(1) = "10011111111111111"
  209. 9511 me$(1,0)="ffffgafgef@@@@@@@"
  210. 9512 mv$(1,0)="6                "
  211. 9513 me$(1,1)="fc@ecdbccfcecdaca"
  212. 9514 mv$(1,1)="45 454  545454  5"
  213. 9515 me$(1,2)="fa@eadbc[191]faeadfcf"
  214. 9516 mv$(1,2)="34 34343434343435"
  215. 9519 rem phrase 2
  216. 9520 md$(2) = "100111111100111111"
  217. 9521 me$(2,0)="[191]@[191][191]cd[191]c@[191]@[191][191]cd[191]ca"
  218. 9522 mv$(2,0)="6   7 67 6   7 676"
  219. 9523 me$(2,1)="@f@@fcgff@f@@fcgff"
  220. 9524 mv$(2,1)=" 5   4545     4545"
  221. 9525 me$(2,2)="[191]d@gdcef[177][191]d@gdcef[177]"
  222. 9526 mv$(2,2)="35 35353535 353535"
  223. 9529 rem phrase 3
  224. 9530 md$(3) = "100111111111111"
  225. 9531 me$(3,0)="[191]@[191][191]cd[191]ca[191]@@@@@"
  226. 9532 mv$(3,0)="6   7 676      "
  227. 9533 me$(3,1)="[191]f@afgeff[191]fafgf"
  228. 9534 mv$(3,1)="45 454545454545"
  229. 9535 me$(3,2)="[191]d@adgcf[177][191]dadgd"
  230. 9536 mv$(3,2)="35 353535353535"
  231. 9539 rem phrase 4
  232. 9540 md$(4) = "1111111111111111"
  233. 9541 me$(4,0)="f[191]c@c@@@d[191]c@@@@@"
  234. 9542 mv$(4,0)="6 7      67     "
  235. 9543 me$(4,1)="fffag[191]aadgfag[191]aa"
  236. 9544 mv$(4,1)="45454545 4 54545"
  237. 9545 me$(4,2)="fdffgeaf[191]fffgeaf"
  238. 9546 mv$(4,2)="3535353534353535"
  239. 9549 rem phrase 5
  240. 9550 md$(5) = "111111111111111111"
  241. 9551 me$(5,0)="cfg@g@@gafg@@@@@@@"
  242. 9552 mv$(5,0)="6                 "
  243. 9553 me$(5,1)="@bgegfge@bfeccafgc"
  244. 9554 mv$(5,1)=" 4 54545 4 5453   "
  245. 9555 me$(5,2)="@aecdbecgacfc[191]afgf"
  246. 9556 mv$(5,2)=" 4 54  534343 2  1"
  247. 9559 rem phrase 6
  248. 9560 md$(6) = "100111111100111111"
  249. 9561 me$(6,0)="ffffgafg@ffffgafge"
  250. 9562 mv$(6,0)="6                 "
  251. 9563 me$(6,1)="cc@dcgdcccc@dcgdcc"
  252. 9564 mv$(6,1)="45 45354545 453545"
  253. 9565 me$(6,2)="fa@eagbc[191]fa@dagbc[191]"
  254. 9566 mv$(6,2)="34 34343434 343434"
  255. 9569 rem phrase 7
  256. 9570 md$(7) = "1001111111111111"
  257. 9571 me$(7,0)="f@ffgafgec@@@c@@"
  258. 9572 mv$(7,0)="6            7  "
  259. 9573 me$(7,1)="fc@ecdbcc@a@[191]cf@"
  260. 9574 mv$(7,1)="45 454  5 4  5  "
  261. 9575 me$(7,2)="fa@eadbc[191]ffgra[177]@"
  262. 9576 mv$(7,2)="34 343434343435 "
  263. 9579 rem phrase 8
  264. 9580 md$(8) = "111100111111111111"
  265. 9581 me$(8,0)="dc@c@[191]afgdf@@@f@@@"
  266. 9582 mv$(8,0)="7    6        7   "
  267. 9583 me$(8,1)="[191]caca@@c@cfdc[191]a@f@"
  268. 9584 mv$(8,1)="5         46 5  4 "
  269. 9585 me$(8,2)="dcfcf@cac[191]f[191]agf@f@"
  270. 9586 mv$(8,2)="54535 4 3435    3 "
  271. 9898 rem set up conversion table
  272. 9900 dim tb%(255)
  273. 9910 for i=0 to 255:tb%(i)=0:next
  274. 9911 for i=65 to 72:tb%(i)=i-64:next
  275. 9912 for i=193 to 199:tb%(i)=i-178:next
  276. 9913 for i=8 to 14:read a:tb%(a)=i:next
  277. 9914 rem next line says: 9915 data 176,191,188,172,177,187,165
  278. 9915 data 176,191,188,172,177,187,165
  279. 9916 rem (line 9915 is deleted by 'make data' option)
  280. 9919 rem find longest phrase, and dim fr$ to exact length needed
  281. 9920 ld%=0:for i=0 to es%:x%=len(md$(i)):if x%>ld% then ld%=x%
  282. 9921 next
  283. 9925 dim fr$(ld%,es%)
  284. 9928 rem convert strings to usable form
  285. 9930 for ph=0 to es%:for n=1 to len(md$(ph)):fr$(n,ph)=""
  286. 9935 for vc=0 to ev%:x%=tb%(asc(mid$(me$(ph,vc),n,1)))
  287. 9940 v$=mid$(mv$(ph,vc),n,1):if v$<>" " then y%(vc)=21*val(v$)
  288. 9945 if x%<>0 then x%=x%+y%(vc)
  289. 9950 fr$(n,ph)=fr$(n,ph)+chr$(pi%(x%,0)):fr$(n,ph)=fr$(n,ph)+chr$(pi%(x%,1))
  290. 9955 next
  291. 9960 if ev%<2 then fr$(n,ph)=fr$(n,ph)+left$(fr$(n,ph),2)
  292. 9965 if ev%<1 then fr$(n,ph)=fr$(n,ph)+left$(fr$(n,ph),2)
  293. 9970 print ".";:next:next
  294. 9980 ph=0
  295. 9990 return
  296. 19998 rem routine to make data statements through forced screen reads
  297. 20000 print "[147]making data statements wipes out all the"
  298. 20001 print "lines not directly needed.":print:print"       proceed? (y or n)"
  299. 20002 a=peek(203):if (a<>39) and (a<>25) then 20002
  300. 20003 if a=39 then 80
  301. 20005 a=49152
  302. 20006 for ph=0 to es%:b=len(md$(ph)):poke a,b:a=a+1:print ">";:for n=1 to b
  303. 20007 poke a,asc(mid$(md$(ph),n,1)):a=a+1:next
  304. 20008 for n=1 to b:for i=1 to 6:poke a,asc(mid$(fr$(n,ph),i,1)):a=a+1
  305. 20009 next:next:next:b=a-1:a=49152:c=9400:cr$=chr$(13):d=4
  306. 20010 print "[147]9350 rem deleted"cr$"9390 data"es%"[157],"ld%cr$;
  307. 20011 print "9002 rem deleted"cr$;
  308. 20015 gosub 20085:if d>8 then 20091
  309. 20020 gosub 20080:if d>8 then 20090
  310. 20025 if a>=b then 20092
  311. 20030 if n=0 then 20015
  312. 20035 goto 20020
  313. 20040 print "[147]";:d=0:cr$=chr$(13):goto 20025
  314. 20041 print "[147]";:d=0:cr$=chr$(13):goto 20020
  315. 20079 rem routine to print fr$() data statement on screen
  316. 20080 printc"data";:fori=1to 6:printpeek(a)"[157],";:a=a+1:next:c=c+1:d=d+1:n=n-1
  317. 20081 print chr$(20)cr$;:return
  318. 20084 rem routine to print md$() data statement on screen
  319. 20085 a$="":n=peek(a):a=a+1:for i=1 to n:a$=a$+chr$(peek(a)):a=a+1:next
  320. 20086 print c"data"chr$(34)a$chr$(34)cr$;:c=c+1:d=d+1:return
  321. 20088 rem set up last line to execute from screen
  322. 20090 print "a="a"[157]:b="b"[157]:c="c"[157]:n="n"[157]:goto 20040"cr$;:goto 20095
  323. 20091 print "a="a"[157]:b="b"[157]:c="c"[157]:n="n"[157]:goto 20041"cr$;:goto 20095
  324. 20092 print "c="c-1":goto 20100"cr$;:goto 20095
  325. 20094 rem load keyboard buffer with carriage returns and go read screen
  326. 20095 for i=631 to 640:poke i,13:next:poke 198,10:print "";:end
  327. 20100 a=peek(43)+256*peek(44):print "[147]";
  328. 20105 b=peek(a+2)+256*peek(a+3):a=peek(a)+256*peek(a+1)
  329. 20106 print ""a"  "b"  "c
  330. 20110 if b=c then 20120
  331. 20115 goto 20105
  332. 20120 poke a,0:poke a+1,0:a=a+2
  333. 20125 b=int(a/256):c=a-256*b
  334. 20130 print "[147]150":print "83"
  335. 20135 print "poke45,"c"[157]:poke46,"b"[157]:poke47,"c"[157]:poke48,"b"[157]:poke49,"c
  336. 20140 print "poke50,"b"[157]:goto 10"
  337. 20145 for i=631 to 640:poke i,13:next:poke 198,10:print "";:end
  338.